Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / bro30_.zip / BROWSE.CLA

Wrap

Text File | 1994-05-26 | 44KB | 650 lines

PROGRAM OMIT('┘') ┌───────────────────────────────────────────────────────────┬────────────────┐ │ │Version:3007.200│ ├───────────────────────────────────────────────────────────┴────────────────┤ │ BROWSE.CLA - The Browse Support Module TER 05/22 3007.200 │ │ │ │ This Browse Module is version 3007.200 with changes to allow 2.1 │ │ type Incremental Browses. The Mouse cannot select the Incremental │ │ Brouse field, and less than one character in an Incremental Browse │ │ field will return you to the Queue. All changes are marked with │ │ !# TER. (The typing delay has also been shortened to react faster.) │ │ Any responses should be addressed to: │ │ Timothy E. Rossin │ │ Compuserve Address: 74072,2630 │ │ │ │ The Browse Support Module manages the process of scrolling records │ │ through a list box. Browse support is conducted in a session that │ │ is initiated by the BeginBrowse procedure and terminated by the │ │ EndBrowse procedure. Multiple browse sessions may be conducted at │ │ the same time (e.g. a browse procedure calls a form which calls a │ │ lookup procedure). The current status of a browse session is │ │ stored in a Session queue. The browse process uses a position │ │ queue which contains a POSITION() string used to access displayed │ │ records. │ │ │ │ BeginBrowse(List,Locator,Immediate,Increment,Nomemo) │ │ │ │ Initiate a browse session and append a new element to the │ │ Session queue. Fixed (non-scrolling) queue elements should be │ │ the only elements in the list queue when a session begins. │ │ │ │ "List" is the field number of a list box that displays a queue │ │ of formatted records. │ │ │ │ "Locator" is an optional parameter that contains the field │ │ number of a locator field. Typing any displayable character │ │ activates the locator field. The USE variable of the locator │ │ field must be a key component, so completing the locator field │ │ scrolls the list box to the first matching record. │ │ │ │ "Immediate" is an optional parameter that contains a 1 if the │ │ selected record is to be accessed each time the selector bar │ │ moves over a new record. │ │ │ │ "Increment" is an optional parameter that contains a 1, 2, 3, │ │ or 4 to request an incremental locator field that automatically │ │ locates a matching record after a pause in typing. Increment │ │ values of 2, 3, and 4 request upper case, lower case, and │ │ capitalized locator fields. An increment value of 1 uses the │ │ case entered by the operator. │ │ │ │ "Nomemo" is an optional parameter that contains a 1 or 2 to │ │ disarm memo fields. A value of 1 means that memos are not │ │ displayed in the list box. A value of 2 means, in addition, │ │ that memos are not used as hot fields. Memos are always │ │ retrieved for "Process Field" actions. │ │ │ │ BrowseAction(File,Key,Queue) │ │ │ │ Manages the behavior of the list box, locator field, and hot │ │ fields. │ │ │ │ "File" is the FILE to be scrolled. │ │ │ │ "Key" is KEY to be used to access the file. │ │ │ │ "Queue" is the display queue, declared by the caller and used │ │ as the parameter of the FROM attribute of the list box. │ │ │ │ BrowseAction returns a code requesting one of the following │ │ actions: the following actions: │ │ │ │ Set the first record and set the last record of a limited │ │ range of consecutive records. │ │ │ │ Reject a record by issueing GET(File,0) to dereference the │ │ record or indicate that a record is out of range by issueing │ │ NEXT(File) or PREVIOUS(File) to move the record position. │ │ │ │ Format a display queue element for the current record. The │ │ queue element will be placed in the display queue by the │ │ browse manager. │ │ │ │ Process the record under the selector bar │ │ │ │ Process a field or key that the browse manager does not │ │ recognize. The selected record has been accessed from the │ │ file and display queue. │ │ │ │ Take action if there are no records to display. │ │ │ │ Clear the key fields subordinate to the locator field. │ │ │ │ EndBrowse │ │ │ │ Terminate the browse session. Free position elements for this │ │ session from the Position queue. Free the last element from │ │ the Session queue. │ │ │ └────────────────────────────────────────────────────────────────────────────┘ INCLUDE('KEYCODES.EQU') MAP BeginBrowse(SHORT,<SHORT>,<BYTE>,<BYTE>,<BYTE>) BrowseAction(FILE,KEY,QUEUE),BYTE EndBrowse END Session QUEUE !Browse session queue Action BYTE ! Caller action Process BYTE ! Internal process List SHORT ! List field number Locator SHORT ! Locator field number Immediate BYTE ! Immediate processing flag Increment BYTE ! Incremental locator flag Nomemo BYTE ! No memo retrieval flag Location STRING(40) ! Locator field contents Length BYTE ! Locator contents length Count BYTE ! List item count Fixed BYTE ! Fixed list item count Item BYTE ! Current item (1 to Count) Choice BYTE ! Selector bar position LastChoice BYTE ! Last Selector position Page STRING(1) ! Current page (F,L,N,blank) FirstPage BYTE ! First page request flag Base SHORT ! Base for position queue Selected STRING(256) ! Selected record position END Position QUEUE !Record position queue STRING(256) ! Record Position END !Caller actions NoAction EQUATE(0) ! No caller action FormatQueue EQUATE(1) ! Format the display queue ProcessField EQUATE(2) ! Process another field NoRecords EQUATE(3) ! No records to display FilterRecord EQUATE(4) ! Filter a record ResetFirst EQUATE(5) ! Set to first of a range ResetLast EQUATE(6) ! Set to last of a range ProcessSelected EQUATE(7) ! Process selected record ClearRestOfKey EQUATE(8) ! Clear low fields of key !Internal processes InitSession EQUATE(1) ! Initialize browse session ProcessForward EQUATE(2) ! Process records forward ProcessBackward EQUATE(3) ! Process records backward ProcessSingle EQUATE(4) ! Process a single record AcceptInput EQUATE(5) ! Accept keyboard input LoChar EQUATE(32) !Lowest displayable char HiChar EQUATE(127) !Highest displayable char CODE !Dummy program BeginBrowse PROCEDURE(InList,InLocator,InImmediate,InIncrement,InNomemo) CODE IF RECORDS(Session) THEN PUT(Session). !Save any current session CLEAR(Session) !Clear the session record Action = NoAction !Set no caller action Process = InitSession !Initialize a browse session List = InList !Set list field number Locator = InLocator !Set locator field number Immediate = InImmediate !Set immediate process flag IF Locator THEN Increment = InIncrement. !If there is a locator field Nomemo = InNomemo !Set no memo flag Count = ROWS(List) !Set item count Choice = 1 !Set top choice LastChoice = 1 !Set top last choice Base = RECORDS(Position) !Set base position ADD(Session,RECORDS(Session)+1) !Add the session record RETURN !Return to caller BrowseAction FUNCTION(File,Key,Queue) !#Delay EQUATE(50) !#TER Time delay (1/2 second) Delay EQUATE(1) !#TER 05/22 Time delay (.01s) SpaceKey EQUATE(32) !Space bar keycode TimeOut LONG !Deadline time (.01 seconds) LocatorContents STRING(255) !Locator field contents CODE CASE Action !Process caller's action OF FilterRecord !Caller filtered the record CASE POSITION(Key) ! Check callers action OF '' ! The record is rejected IF Process = ProcessSingle ! And previously accepted DELETE(Queue) ! Delete the queue element GET(Position,Base+Choice-Fixed) ! Get the position element DELETE(Position) ! And delete it Process = ProcessForward ! Display a new last Item = RECORDS(Queue) + 1 ! record forward GET(Position,RECORDS(Position)) ! Get last display record RESET(Key,Position) ! Reset to last display NEXT(File) ! Retrieve last record END ! End IF OF Position ! The record is accepted Action = FormatQueue ! Ask caller to format RETURN(Action) ! Return to caller ELSE ! The record is out of range DISPLAY(List) ! Display the page SELECT(List,Choice) ! Select the list box Selected = '' ! Clear selected position Process = AcceptInput ! Get keyboard input END ! End CASE OF FormatQueue !Caller formatted the queue CASE Process ! Jump to current process OF ProcessForward ! On forward processing ADD(Queue,RECORDS(Queue)+1) ! Add new last element ADD(Position,RECORDS(Position)+1) ! Add new last position IF RECORDS(Queue) > Count ! If the page overflows GET(Queue,Fixed+1) ! Get the first element DELETE(Queue) ! And delete it GET(Position,Base+1) ! Get the first position DELETE(Position) ! And delete it END ! End IF Item += 1 ! Increment current item OF ProcessBackward ! On backward processing ADD(Queue,Fixed+1) ! Add new first element ADD(Position,Base+1) ! Add new first position IF RECORDS(Queue) > Count ! If the page overflows GET(Queue,RECORDS(Queue)) ! Get the last element DELETE(Queue) ! And delete it GET(Position,RECORDS(Position)) ! GET the last position DELETE(Position) ! And delete it END ! End IF Item -= 1 ! Decrement current item IF Page = 'N' THEN Choice += 1. ! Increment selector bar OF ProcessSingle ! On a single record PUT(Queue) ! Replace the element DISPLAY(List) ! Display the page SELECT(List,Choice) ! Select the list box Process = AcceptInput ! Get keyboard input Selected = '' ! Clear selected position END ! End CASE OF ProcessSelected !Caller processed a record Selected = POSITION(Key) ! Set selected position OF ProcessField ! Caller processed a field IF Process = InitSession ! If we got here from Init code Process = AcceptInput ! Skip internal field handling Action = NoAction ! Clear ACTION RETURN(Action) ! And go another time around END ! END (If we got here...) IF FIELD() <> Locator ! For non-locator field IF Increment ! If incremental locator DO ClearLocator ! Clear locator END ! End IF IF INRANGE(FIELD(),1,List-1) ! From a prior field FirstPage = 1 ! Request the first page END ! End IF END ! End IF IF SELECTED() = Locator AND Increment AND KEYCODE() <> TabKey !# TER 05/22 DO ClearLocator !# TER 05/22 If Incremental DO FirstPage !# TER 05/22 Locator, don't Action = ResetFirst !# TER 05/22 Allow select RETURN(Action) !# TER 05/22 Unless it's END !# TER 05/22 TAB Key IF SELECTED() = List ! If list field is selected IF FirstPage ! If first page is requested DO FirstPage ! Display the first page Action = ResetFirst ! Ask caller to first RETURN(Action) ! record in range ELSIF FIELD() <> Locator ! From any but the locator CASE POSITION(Key) ! Check the record OF '' ! If record was dereferenced DO GetChoice ! Get selected record IF POSITION(Key) = Position ! If record is still there Process = ProcessSingle ! Display one record Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller ELSE ! If record was deleted DELETE(Queue) ! Delete the element DELETE(Position) ! Delete its position IF RECORDS(Queue) = Fixed ! If queue is now empty DO LastPage ! Display the last page Action = ResetLast ! Ask caller to reset to RETURN(Action) ! last record in range ELSE ! Otherwise Process = ProcessForward ! Display a new Item = RECORDS(Queue) + 1 ! last record GET(Position,RECORDS(Position)) ! Reset to the bottom RESET(Key,Position) ! record displayed NEXT(File) ! Read the record END ! End IF END ! End IF OF Position ! If record didn't move GET(Queue,Choice) ! Get display element Action = FilterRecord ! Ask caller to Process = ProcessSingle ! filter one record RETURN(Action) ! Return to caller ELSE ! If record moved DO NewPage ! Display the new page END ! End CASE END ! End IF ELSE ! Else another field selected IF FIELD() <> SELECTED() ! If selecting a new field Process = AcceptInput ! Accept keyboard input END ! End IF END ! End IF OF NoRecords !Caller added a record IF SELECTED() = List ! And selected the list field DO FirstPage ! Display the first page Action = ResetFirst ! Ask caller to reset to RETURN(Action) ! first record in range END ! End IF OF ClearRestOfKey !Caller cleared subfields SELECT(Locator) ! Select the locator field Process = AcceptInput ! Accept keyboard input END !End CASE LOOP !Main processing loop CASE Process !Jump to current process OF InitSession !Start browse session Fixed = RECORDS(Queue) ! Set fixed list item count IF List <> 1 ! If the List is not first Action = ProcessField ! Process any FIELD code RETURN(Action) ! Do It! ELSE Process = AcceptInput ! Accept keyboard input END ! END (If the List...) OF ProcessForward !Process records forward IF Item <= Count ! If page is not full IF Nomemo THEN NOMEMO(File). ! Disarm unneeded memos NEXT(File) ! Read the next record IF ~ERRORCODE() ! If a record was found Position = POSITION(Key) ! Save its position Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller ELSE ! If no record was found IF INSTRING(Page,'FN',1,1) ! If new page Process = ProcessBackward ! Display prior records Item = Count - Item + Fixed + 1 ! from the top record IF RECORDS(Position) > Base ! For a partial screen GET(Position,Base+1) ! Get top position RESET(Key,Position) ! Reset to top record PREVIOUS(File) ! Point to prior page CYCLE ! Process backwards ELSE ! For a blank screen SET(Key) ! Set to end of file Action = ResetLast ! Ask caller to reset RETURN(Action) ! Return to caller END ! End IF END ! End IF END ! End IF END ! End IF DISPLAY(List) ! Display the page SELECT(List,Choice) ! Select the list box Selected = '' ! Clear selected position Process = AcceptInput ! Get keyboard input OF ProcessBackward !Process records backward IF Item >= Fixed + 1 ! If page is not full IF Nomemo THEN NOMEMO(File). ! Disarm unneeded memos PREVIOUS(File) ! Read the prior record IF ~ERRORCODE() ! If a record was found Position = POSITION(Key) ! Save its position Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller END ! End IF END ! If page is full DISPLAY(List) ! Display the page SELECT(List,Choice) ! Select the list box Selected = '' ! Clear selected position Process = AcceptInput ! Get keyboard input OF AcceptInput !Get keyboard input IF SELECTED() = List ! If the list box is selected IF RECORDS(Queue) = Fixed ! If there are no records CASE Page ! Jump to current page OF 'F' ! On the first page GET(File,0) ! Clear the current record Action = NoRecords ! Ask caller for records OF 'N' ! On a new page DO LastPage ! Display the last page Action = ResetLast ! Ask for last record ELSE ! On any other page DO FirstPage ! Display the first page Action = ResetFirst ! Ask for first record END ! End CASE RETURN(Action) ! Return to caller END ! End IF IF Immediate ! For immediate processing GET(Position,Base+CHOICE(List)-Fixed) ! Get selected position IF Selected <> Position ! If selector moved GET(Position,Base+Choice-Fixed) ! Get selected position RESET(Key,Position) ! Reset to that record IF Nomemo = 2 THEN NOMEMO(File). ! Disarm unneeded memos NEXT(File) ! Read the record IF Position = POSITION(Key) ! If record is there Action = ProcessSelected ! Ask to process record RETURN(Action) ! Return to caller ELSE ! Else DO NewPage ! Rebuild the Queue Action = ProcessField ! Ask to process record RETURN(Action) ! Return to caller END ! End IF END ! End IF END ! End IF IF Locator ! If there is a locator field ERASE(Locator) ! Erase locator contents IF Increment ! For incremental locator DO ShowLocator ! Show locator field END ! End IF END ! End IF LastChoice = CHOICE(List) ! Save selector position END !End IF ACCEPT !Enable the keyboard CASE FIELD() !Jump to field edit routine OF Locator !Process the locator field IF CONTENTS(Locator) ! If locator is requested IF Increment ! If incremental locator Location = CONTENTS(Locator) ! Save location Length = LEN(CLIP(Location)) ! Save location length END ! End IF SELECT(List) ! Select the list box DO NewPage ! Display a new page Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller ELSE ! ELSE (If No Locator) Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END ! End IF OF List !Process the list field Choice = CHOICE(List) ! Save selector bar position IF SELECTED() <> List ! Process any new fields IF SELECTED() <> Locator ! IF not locating DO GetChoice ! Get the highlighted record END ! END (IF not locating) Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END ! END (Process...) CASE KEYCODE() ! Jump to key edit routine OF LoChar TO HiChar ! For any locator character OROF BSKey OROF SpaceKey ! Or a backspace or space IF Locator ! If there is a locator IF Increment ! On incremental locator DO GatherKeys ! Gather keystrokes IF Location ! If not blank PRESS(SUB(Location,1,Length)) ! Press the string PRESS(DownKey) ! Complete the field SELECT(Locator) ! Select locator ELSE !# TER 05/22 Else less than Action = ResetFirst !# TER 05/22 One, so return RETURN(Action) !# TER 05/22 With Action END ! End IF ELSE ! On standard locator PRESS(KEYCODE()) ! Press in the keycode SELECT(Locator) ! Select locator field END ! End IF Action = ClearRestOfKey ! Ask caller to clear RETURN(Action) ! subordinate fields END ! End IF OF CtrlPgUp ! Process the Ctrl-PgUp key DO FirstPage ! Display the first page IF Increment ! If incremental locator DO ClearLocator ! Clear locator field END ! End IF Action = ResetFirst ! Ask caller to reset to RETURN(Action) ! first record in range OF PgUpKey ! Process the PgUp key IF LastChoice <> Fixed + 1 ! If not at the top Choice = Fixed + 1 ! Selector bar to top ELSE ! From the top Page = '' ! Clear page flag Process = ProcessBackward ! Display a new page Item = Count ! of records backward GET(Position,Base+1) ! Reset to the top RESET(Key,Position) ! record displayed PREVIOUS(File) ! Point to prior record END ! End IF OF UpKey ! Process the up arrow IF LastChoice = Fixed + 1 ! From the top line Page = '' ! Clear page flag Process = ProcessBackward ! Display a single Item = Fixed + 1 ! record backward GET(Position,Base+1) ! Reset to the top RESET(Key,Position) ! record displayed PREVIOUS(File) ! Point to prior record END ! End IF OF DownKey ! Process the down arrow IF LastChoice = Count ! From the bottom line Page = '' ! Clear page flag Process = ProcessForward ! Display a single Item = Count ! record forward GET(Position,RECORDS(Position)) ! Reset to the bottom RESET(Key,Position) ! record displayed NEXT(File) ! Point to the next record END ! End IF OF PgDnKey ! Process the PgDn key IF LastChoice <> Count ! If not at the bottom Choice = Count ! Selector bar to bottom ELSE ! From the bottom Page = '' ! Clear page flag Process = ProcessForward ! Display a new page Item = 1 + Fixed ! of records forwards GET(Position,RECORDS(Position)) ! Reset to the bottom RESET(Key,Position) ! record displayed NEXT(File) ! Point to the next record END ! End IF OF CtrlPgDn ! Process the Ctrl-PgDn Key DO LastPage ! Display the last page IF Increment ! If incremental locator DO ClearLocator ! Clear locator field END ! End IF Action = ResetLast ! Ask caller to reset to RETURN(Action) ! last record in range OF LeftKey ! For left arrow key, OROF Rightkey ! Or right arrow key, OROF Homekey ! Or Home key, OROF Endkey ! Or End key, OROF MouseLeft ! Or a mouse click ! Don't do anything IF Increment !#TER If incremental locator DO ClearLocator !#TER Clear locator field END !#TER End IF ELSE ! For any other key DO GetChoice ! Get selected record Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END ! End CASE KEYCODE() IF Increment ! If incremental locator DO ClearLocator ! Clear locator field END ! End ELSE ! Process any other field IF FIELD() >= List OR FIELD() < 0 ! If not list or setup fld DO GetChoice ! Get selected record ELSIF SELECTED() = List and ~FIELD() ! Else if reprocessing List DO GetChoice ! Get selected record END ! End IF Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END ! End CASE FIELD() END !End CASE BrowseProcess END !End LOOP GetChoice ROUTINE !Get selected record GET(Queue,Choice) ! Get selected element GET(Position,Base+Choice-Fixed) ! Get selected position RESET(Key,Position) ! Reset to that record NEXT(File) ! Read the record FirstPage ROUTINE !Display first page FirstPage = 0 ! Clear first page request Page = 'F' ! Set first page flag DO DeletePage ! Delete the old page Choice = Fixed + 1 ! Reset selector bar Process = ProcessForward ! Display a new page Item = Fixed + 1 ! of records forward SET(Key) ! Set to the first record LastPage ROUTINE !Display last page Page = 'L' ! Set last page flag DO DeletePage ! Delete the old page Choice = Count ! Reset selector bar Process = ProcessBackward ! Display a new page Item = Count ! of records backward SET(Key) ! Set to the last record NewPage ROUTINE !Display a new page Page = 'N' ! Set new page flag DO DeletePage ! Delete the old page SET(Key,Key) ! Set to the new record Choice = Fixed + 1 ! Selector bar to top Process = ProcessForward ! Display a new page Item = Fixed + 1 ! of records forward DeletePage ROUTINE !Delete the current page LOOP WHILE RECORDS(Queue) > Fixed ! Delete all queue GET(Queue,RECORDS(Queue)) ! elements after the DELETE(Queue) ! fixed elements END ! End LOOP LOOP WHILE RECORDS(Position) > Base ! Delete all position GET(Position,RECORDS(Position)) ! elements after the DELETE(Position) ! base position END ! End LOOP GatherKeys ROUTINE !Gather locator keystrokes DO AppendKey ! Append pending keystroke TimeOut = CLOCK() + Delay ! Set the time delay LOOP UNTIL CLOCK() > TimeOut ! Loop until time out IF KEYBOARD() ! If there is a keystroke ASK ! Read the keystroke DO AppendKey ! Append the keystroke DO ShowLocator ! Show the user TimeOut = CLOCK() + Delay ! Reset the time delay END ! End IF END ! End LOOP AppendKey ROUTINE !Append keystroke to locator CASE KEYCODE() ! Process the keystroke OF LoChar TO HiChar OROF SpaceKey ! For a character IF Length < COLS(Locator) ! If it will fit Location = SUB(Location,1,Length) & CHR(KEYCODE()) ! Add it on Length += 1 ! Increment the length END ! End IF OF BSKey ! For a backspace IF Length > 0 !# TER Decrement the length Length -= 1 !# TER 05/22 ELSE !# TER 05/22 Action = ResetFirst !# TER 05/22 RETURN(Action) !# TER 05/22 END !# TER 05/22 Location = SUB(Location,1,Length) ! Shorten the string EXECUTE Increment - 1 ! For locator case Location = UPPER(Location) ! Upper case location Location = LOWER(Location) ! Lower case location Location = UPPER(SUB(Location,1,1)) | ! Capitalize location & LOWER(SUB(Location,2,SIZE(Location)-1)) END ! End EXECUTE END ! End CASE ClearLocator ROUTINE !Clear locator field Location = '' ! Clear field string Length = 0 ! Zero field length DO ShowLocator ! Show locator field ShowLocator ROUTINE !Show locator field contents SHOW(ROW(Locator),COL(Locator),SUB(Location,1,COLS(Locator))) EndBrowse PROCEDURE CODE LOOP WHILE RECORDS(Position) > Base !Delete all position GET(Position,RECORDS(Position)) ! elements after the DELETE(Position) ! base position END !End LOOP DELETE(Session) !Delete the current session IF RECORDS(Session) !For any prior session GET(Session,RECORDS(Session)) ! Get the session element END !End IF RETURN !Return to caller